Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr05/mswlogo3.zip/MSWLOGO.ZIP/EXAMPLES.ZIP/MATH

Text File | 1993-04-12 | 7KB | 259 lines

;
; Function:
;
; Logic analysis program (very powerful)
;
; To run:
;
; load "math
; Call PROBLEM
;
; You can write your own "problems" using PROBLEM as a template.
;
TO CATEGORY :NAME :MEMBERS
PRINT (LIST "CATEGORY :NAME :MEMBERS)
IF NOT NAMEP "CATEGORIES [MAKE "CATEGORIES []]
MAKE "CATEGORIES LPUT :NAME :CATEGORIES
MAKE :NAME :MEMBERS
FOREACH :MEMBERS [PPROP ? "CATEGORY :NAME]
END

TO CHOOSE :N :R
OUTPUT (PERMS :N :R)/(FACT :R)
END

TO CLEAN1 :CATEGORY
FOREACH THING :CATEGORY [ERPL ?]
ERN :CATEGORY
END

TO CLEANUP
FOREACH :CATEGORIES [CLEAN1 ?]
ERN "CATEGORIES
END

TO COMBS :LIST :HOWMANY
IF EQUALP :HOWMANY 0 [OP [[]]]
IF EQUALP :HOWMANY COUNT :LIST [OP (LIST :LIST)]
OP SE (MAP [FPUT FIRST :LIST ?] COMBS (BF :LIST) (:HOWMANY-1)) ~
      (COMBS (BF :LIST) :HOWMANY)
END

TO DIFFER :LIST
PRINT (LIST "DIFFER :LIST)
FOREACH :LIST [DIFFER1 ? ?REST]
END

TO DIFFER1 :WHO :THEM
FOREACH :THEM ~
        [IF NOT EQUALP (GPROP :WHO "CATEGORY) (GPROP ? "CATEGORY) ~
            [FALSIFY :WHO ?]]
END

TO EXPAND :LIST
IF EMPTYP :LIST [OP []]
IF NUMBERP FIRST :LIST ~
   [OP CASCADE (FIRST :LIST) [FPUT FIRST BF :LIST ?] (EXPAND BF BF :LIST)]
OP FPUT FIRST :LIST EXPAND BF :LIST
END

TO F :N
IF EQUALP :N 0 [OUTPUT 1]
OUTPUT CASCADE :N [? + ((CHOOSE :N (#-1)) * F (#-1))] 0
END

TO FACT :N
OUTPUT CASCADE :N [# * ?] 1
END

TO FALSES :WHO :WHAT
OUTPUT COUNT FILTER [EQUALP "FALSE GET ? :WHAT] PEERS :WHO
END

TO FALSIFY :WHO :WHAT
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT
IF EQUALP :OLDVALUE "FALSE [STOP]
IF EQUALP :OLDVALUE "TRUE ~
   [PR (SE [INCONSISTENCY FALSIFYING] :WHO "IS :WHAT) THROW "TOPLEVEL]
PR (LIST "FALSIFY :WHO :WHAT)
STORE :WHO :WHAT "FALSE
IF NOT EMPTYP :OLDVALUE [LINKFALSE :OLDVALUE]
IF EQUALP (COUNT PEERS :WHO) (1+FALSES :WHO :WHAT) [FINDTRUE :WHO :WHAT]
IF EQUALP (COUNT PEERS :WHAT) (1+FALSES :WHAT :WHO) [FINDTRUE :WHAT :WHO]
FOREACH (GPROP :WHO "TRUTH) [MAYBEFALSIFY ? :WHAT]
FOREACH (GPROP :WHAT "TRUTH) [MAYBEFALSIFY :WHO ?]
PPROP :WHO "FALSEHOOD (FPUT :WHAT GPROP :WHO "FALSEHOOD)
PPROP :WHAT "FALSEHOOD (FPUT :WHO GPROP :WHAT "FALSEHOOD)
END

TO FINDFALSE :THEM :WHAT
FOREACH (FILTER [NOT EQUALP GET ? :WHAT "TRUE] :THEM) [FALSIFY ? :WHAT]
END

TO FINDTRUE :WHO :WHAT
VERIFY (FIND [NOT EQUALP "FALSE GET ? :WHAT] PEERS :WHO) :WHAT
END

TO GET :A :B
OUTPUT GETINORDER :A :B :CATEGORIES
END

TO GETINORDER :A :B :ORDER
IF EMPTYP :ORDER [PRINT (SE [UNKNOWN OBJECTS] :A :B) THROW "TOPLEVEL]
IF MEMBERP :A THING FIRST :ORDER [OUTPUT GPROP :A :B]
IF MEMBERP :B THING FIRST :ORDER [OUTPUT GPROP :B :A]
OUTPUT GETINORDER :A :B BF :ORDER
END

TO LINK :WHO :WHAT1 :WHAT2
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT1
IF EMPTYP :OLDVALUE [STORE :WHO :WHAT1 (LIST :WHO :WHAT2) STOP]
IF EQUALP :OLDVALUE "TRUE [FALSIFY :WHO :WHAT2 STOP]
IF EQUALP :OLDVALUE "FALSE [VERIFY :WHO :WHAT2 STOP]
STORE :WHO :WHAT1 (SE :OLDVALUE :WHO :WHAT2)
END

TO LINKFALSE :LIST
IF EMPTYP :LIST [STOP]
VERIFY (FIRST :LIST) (FIRST BF :LIST)
LINKFALSE BF BF :LIST
END

TO LINKTRUE :LIST
IF EMPTYP :LIST [STOP]
FALSIFY (FIRST :LIST) (FIRST BF :LIST)
LINKTRUE BF BF :LIST
END

TO LOCK1 :TOTAL :BUTTONS
LOCAL "PERMS
MAKE "PERMS PERMS :TOTAL :BUTTONS
OUTPUT CASCADE (TWOTO (:BUTTONS-1)) [? + LOCK2 :PERMS #-1 1] 0
END

TO LOCK2 :PERMS :LINKS :FACTOR
IF EQUALP :LINKS 0 [OUTPUT :PERMS/(FACT :FACTOR)]
IF EQUALP (REMAINDER :LINKS 2) 0 [OUTPUT LOCK2 :PERMS/(FACT :FACTOR) :LINKS/2 1]
OUTPUT LOCK2 :PERMS (:LINKS-1)/2 :FACTOR+1
END

TO LOCK :BUTTONS
OUTPUT CASCADE :BUTTONS [? + LOCK1 :BUTTONS #] 1
END

TO MAYBEFALSIFY :WHO :WHAT
IF NOT EQUALP (GPROP :WHO "CATEGORY) (GPROP :WHAT "CATEGORY) [FALSIFY :WHO :WHAT]
END

TO PEERS :WHO
OUTPUT THING GPROP :WHO "CATEGORY
END

TO PERMS :N :R
IF EQUALP :R 0 [OUTPUT 1]
OUTPUT :N * PERMS :N-1 :R-1
END

TO PROBLEM
CATEGORY "FIRST [JANE LARRY OPAL PERRY]
CATEGORY "LAST [IRVING KING MENDLE NATHAN]
CATEGORY "AGE [32 38 45 55]
CATEGORY "JOB [DRAFTER PILOT SERGEANT DRIVER]
DIFFER [JANE KING LARRY NATHAN]
SAYS "JANE "IRVING 45
SAYS "KING "PERRY "DRIVER
SAYS "LARRY "SERGEANT 45
SAYS "NATHAN "DRAFTER 38
DIFFER [MENDLE JANE OPAL NATHAN]
SAYS "MENDLE "PILOT "LARRY
SAYS "JANE "PILOT 45
SAYS "OPAL 55 "DRIVER
SAYS "NATHAN 38 "DRIVER
PRINT []
SOLUTION
END

TO SAYS :WHO :WHAT1 :WHAT2
PRINT (LIST "SAYS :WHO :WHAT1 :WHAT2)
LINK :WHO :WHAT1 :WHAT2
LINK :WHO :WHAT2 :WHAT1
END

TO SIMPLEX :BUTTONS
OUTPUT 2 * F :BUTTONS
END

TO SOCKS :LIST
LOCAL [TOTAL MATCHING]
MAKE "TOTAL COMBS (EXPAND :LIST) 2
MAKE "MATCHING FILTER [EQUALP FIRST ? LAST ?] :TOTAL
PR (SE [THERE ARE] COUNT :TOTAL [POSSIBLE PAIRS OF SOCKS.])
PR (SE [OF THESE,] COUNT :MATCHING [ARE MATCHING PAIRS.])
PR SE [PROBABILITY OF MATCH =] ~
      WORD (100 * (COUNT :MATCHING)/(COUNT :TOTAL)) "%
END

TO SOCKTEST
LOCAL [FIRST SECOND]
MAKE "FIRST PICK [BROWN BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE BLUE]
MAKE "SECOND ~
     PICK (IFELSE EQUALP :FIRST "BROWN ~
                  [[BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE BLUE]] ~
                  [[BROWN BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE]])
OUTPUT EQUALP :FIRST :SECOND
END

TO SOLUTION
FOREACH THING FIRST :CATEGORIES [SOLVE1 ? BF :CATEGORIES]
END

TO SOLVE1 :WHO :ORDER
TYPE :WHO
FOREACH :ORDER [TYPE CHAR 32 TYPE GPROP :WHO ?]
PRINT []
END

TO STORE :A :B :VAL
STOREINORDER :A :B :VAL :CATEGORIES
END

TO STOREINORDER :A :B :VAL :ORDER
IF EMPTYP :ORDER [PRINT (SE [UNKNOWN OBJECTS] :A :B) THROW "TOPLEVEL]
IF MEMBERP :A THING FIRST :ORDER [PPROP :A :B :VAL STOP]
IF MEMBERP :B THING FIRST :ORDER [PPROP :B :A :VAL STOP]
STOREINORDER :A :B :VAL BF :ORDER
END

TO T :N :K
IF EQUALP :K 0 [OUTPUT 1]
IF EQUALP :N 0 [OUTPUT 0]
OUTPUT (T :N :K-1)+(T :N-1 :K)
END

TO TWOTO :POWER
OUTPUT CASCADE :POWER [2 * ?] 1
END

TO VERIFY :WHO :WHAT
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT
IF EQUALP :OLDVALUE "TRUE [STOP]
IF EQUALP :OLDVALUE "FALSE ~
   [PR (SE [INCONSISTENCY VERIFYING] :WHO "IS :WHAT) THROW "TOPLEVEL]
PR (LIST "VERIFY :WHO :WHAT)
STORE :WHO :WHAT "TRUE
PPROP :WHO (GPROP :WHAT "CATEGORY) :WHAT
PPROP :WHAT (GPROP :WHO "CATEGORY) :WHO
IF NOT EMPTYP :OLDVALUE [LINKTRUE :OLDVALUE]
FINDFALSE (PEERS :WHO) :WHAT
FINDFALSE (PEERS :WHAT) :WHO
FOREACH (GPROP :WHO "TRUTH) [VERIFY ? :WHAT]
FOREACH (GPROP :WHAT "TRUTH) [VERIFY :WHO ?]
FOREACH (GPROP :WHO "FALSEHOOD) [MAYBEFALSIFY ? :WHAT]
FOREACH (GPROP :WHAT "FALSEHOOD) [MAYBEFALSIFY :WHO ?]
PPROP :WHO "TRUTH (FPUT :WHAT GPROP :WHO "TRUTH)
PPROP :WHAT "TRUTH (FPUT :WHO GPROP :WHAT "TRUTH)
END